home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 6 / 64er_Magazin_Sonderheft_06_86-06_1986_Markt__Technik_de_Disk_2_of_3_Side_A.d64 / listing 6 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  10KB  |  311 lines
  1. 5 rem  **********************************
  2. 10 rem *   giga-cad     graphic-system  *
  3. 15 rem *        'cad.hardcopy'          *
  4. 20 rem * by s. vilsmeier & s. lippstreu *
  5. 25 rem **********************************
  6. 30 :
  7. 35 :
  8. 40 a=peek(836)+1:poke836,a:ifa=1thengosub1525:load"hard.cad.obj",8,1
  9. 45 dima(30,6),b(20):open1,8,15
  10. 50 open2,8,2,"cad.printer.datas,s,r":gosub305:iff<>0thenclose2:goto70
  11. 55 input#2,d$
  12. 60 forx=0to5:input#2,a(0,x):input#2,a(1,x):input#2,a(2,x):fori=3toa(2,x)+2
  13. 65 input#2,a(i,x):next:next:close2:gosub305:close1:dd=a(2,1)
  14. 70 open1,8,15,"u9":close1:printchr$(14)chr$(8):poke53280,14
  15. 75 :
  16. 80 :
  17. 85 rem **********************************
  18. 90 rem *          hauptmenue            *
  19. 95 rem **********************************
  20. 100 :
  21. 105 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  22. 110 print"         [200]ardcopy - [200]auptmenue         [146]"
  23. 115 fori=1to21:print" [180]                                    [170]":next
  24. 120 print"                                       [146]"
  25. 125 print" [193]. - [197]inzelne [199]rafik laden"
  26. 130 print" [194]. - [200]ardcopy 1-fach"
  27. 135 print" [195]. - [200]ardcopy 4-fach"
  28. 140 print" [196]. - [200]ardcopy 10-fach"
  29. 145 print" [197]. - [197]infache [196]ichte";
  30. 150 ifdmthenprint"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][196]oppelte";
  31. 155 print:print" [198]. - [196]ruckeranpassung"
  32. 160 print" [199]. - [196]iskettenkommando senden"
  33. 165 print" [200]. - [196]irectory anzeigen"
  34. 170 print" [201]. - [196]ruckerkommando senden"
  35. 175 print" [202]. - [196]ruckerparameter pruefen"
  36. 180 print" [196]ruckertyp : ";d$;"[146]";
  37. 185 getx$:ifx$<"a"orx$>"j"goto185
  38. 190 onasc(x$)-64goto225,435,620,695,520,770,375,560,1415,1125
  39. 195 :
  40. 200 :
  41. 205 rem *********************************
  42. 210 rem *         grafik laden          *
  43. 215 rem *********************************
  44. 220 :
  45. 225 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  46. 230 print"               [199]rafik laden            [146]":gosub1545
  47. 235 input" [206]ame ";n$:ifn$=""orn$="_"goto70
  48. 240 iflen(n$)>10goto235
  49. 245 sys50192,11,15,1:sys50299,1
  50. 250 open2,8,2,"pi."+n$+",p,r":fk=1:open1,8,15:gosub305
  51. 255 iff<>0thensys50299,0:close2:goto70
  52. 260 sys50442,1:close2:close1
  53. 265 sys50299,0:goto70
  54. 270 :
  55. 275 :
  56. 280 rem *********************************
  57. 285 rem *       disketten-fehler        *
  58. 290 rem *********************************
  59. 295 :
  60. 300 open1,8,15:fk=0
  61. 305 input#1,f,f$,t,s:iff=0thenreturn
  62. 310 iffkthensys50299,0:printchr$(14);chr$(8)
  63. 315 print:print" [196]iskettenstatus :"
  64. 320 print""f","f$","t","s
  65. 325 poke198,0
  66. 330 getx$:ifx$=""goto330
  67. 335 close2:close1:return
  68. 340 goto105
  69. 345 :
  70. 350 :
  71. 355 rem *********************************
  72. 360 rem *    diskettenkommando senden   *
  73. 365 rem *********************************
  74. 370 :
  75. 375 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  76. 380 print"        [196]iskettenkommando senden       [146]":gosub1545
  77. 385 poke631,34:poke198,1
  78. 390 input" [203]ommando ";c$:ifc$=""goto70
  79. 395 open1,8,15,c$:gosub305:iff=0thengosub315
  80. 400 close2:close1:goto70
  81. 405 :
  82. 410 :
  83. 415 rem *********************************
  84. 420 rem *        hardcopy 1-fach        *
  85. 425 rem *********************************
  86. 430 :
  87. 435 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  88. 440 print"             [200]ardcopy 1-fach           [146]":gosub1545
  89. 445 gosub1205:ifdmthengoto465
  90. 450 x=1:gosub1250:open4,4,a(1,4)
  91. 455 x=4:fors=0to24:gosub1250:sys50475,s*320,0,0,0:print#4:nexts:gosub1215
  92. 460 goto105
  93. 465 open4,4,a(1,2)
  94. 470 fors=0to24step2:x=0:sz=1:gosub1250:x=2:gosub1250
  95. 475 sys50475,s*320,1,0,0:print#4:x=0:sz=15:gosub1250:x=2:gosub1250
  96. 480 sys50475,s*320,1,1,0:print#4:nexts:gosub1215:goto105
  97. 485 goto70
  98. 490 :
  99. 495 :
  100. 500 rem *********************************
  101. 505 rem *      menuepunkt 'e'           *
  102. 510 rem *********************************
  103. 515 :
  104. 520 ifdd=0goto185
  105. 525 dm=1-dm:goto125
  106. 530 :
  107. 535 :
  108. 540 rem *********************************
  109. 545 rem *       directory anzeigen      *
  110. 550 rem *********************************
  111. 555 :
  112. 560 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  113. 565 print"           [196]irectory anzeigen          [146]"
  114. 570 print"":open2,8,0,"$0":gosub300:iffgoto70
  115. 575 sys50901:close2:close1:poke198,0
  116. 580 getx$:ifx$=""goto580
  117. 585 goto70
  118. 590 :
  119. 595 :
  120. 600 rem *********************************
  121. 605 rem *       hardcopy 4-fach         *
  122. 610 rem *********************************
  123. 615 :
  124. 620 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  125. 625 print"             [200]ardcopy 4-fach           [146]":gosub1545
  126. 630 n$="":input"[198]ile - [206]ame ";n$:ifn$=""orn$="_"goto105
  127. 635 forq=1to4step2:open2,8,2,"hv."+n$+str$(q)+",p,r":sys50442,1:close2
  128. 640 open2,8,2,"hv."+n$+str$(q+1)+",p,r":sys50442,2:close2
  129. 645 gosub300:iff<>0goto105
  130. 650 close1:ifdmthengosub1070:goto660
  131. 655 gosub1025
  132. 660 nextq:goto105
  133. 665 :
  134. 670 :
  135. 675 rem *********************************
  136. 680 rem *       hardcopy 10-fach        *
  137. 685 rem *********************************
  138. 690 :
  139. 695 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  140. 700 print"               [200]ardcopy 10-fach        [146]":gosub1545
  141. 705 n$="":input"[198]ile - [206]ame ";n$:ifn$=""orn$="_"goto105
  142. 710 forq=1to10step2:open2,8,2,"hz."+n$+str$(q)+",p,r":sys50442,1:close2
  143. 715 open2,8,2,"hz."+n$+str$(q+1)+",p,r":sys50442,2:close2
  144. 720 gosub300:iff<>0goto105
  145. 725 close1:ifdmthengosub1070:goto735
  146. 730 gosub1025
  147. 735 nextq:goto105
  148. 740 :
  149. 745 :
  150. 750 rem *********************************
  151. 755 rem *       druckeranpassung        *
  152. 760 rem *********************************
  153. 765 :
  154. 770 gosub1300
  155. 775 print"[215]elchen [196]rucker haben":print"[211]ie denn   ";d$
  156. 780 input"[145]";d$:d$=left$(d$,19)
  157. 785 ifd$="_"goto105
  158. 790 gosub1300:print"[206]un muss eingegeben werden, ob ihr"
  159. 795 print"[196]rucker ueber die [205]oeglichkeit ver-"
  160. 800 print"fuegt, [199]rafiken in doppelter [196]ichte"
  161. 805 print"mit einem [218]eilenabstand von n halben "
  162. 810 print"[208]unkten auszudrucken."
  163. 815 input"[206]un, ist dies moeglich (j/n) ";n1$
  164. 820 dd=1:ifn1$="n"thendd=0:goto850
  165. 825 gosub1300:print"[215]ieviele [211]teuerzeichen muessen [211]ie"
  166. 830 print"senden, um den [218]eilenabstand auf  "
  167. 835 print"n/144 [201]nch festzulegen  ";a(2,0)
  168. 840 input"[145]";a(2,0)
  169. 845 x=0:gosub1310:ifa$<>"j"goto825
  170. 850 gosub1300:print"[206]un ist die [193]nzahl der [211]teuerzeichen"
  171. 855 print"von [201]nteresse, um den [196]rucker auf"
  172. 860 print"einen [218]eilenabstand von 8/72 [201]nch "
  173. 865 print"einzustellen. [193]nzahl  ";a(2,1)
  174. 870 input"[145]";a(2,1):x=1:gosub1310:ifa$<>"j"goto850
  175. 875 ifdd=0goto925
  176. 880 gosub1300:print"[215]ieviel [195]odes muessen gesendet wer-"
  177. 885 print"den, um [201]hren [196]rucker zum [193]usdruck"
  178. 890 print"von 320 [208]unktspalten in doppelter"
  179. 895 print"[196]ichte zu bewegen  ";a(2,2)
  180. 900 input"[145]";a(2,2):x=2:gosub1310:ifa$<>"j"goto880
  181. 905 gosub1300:print"[205]it welcher [193]nzahl an [196]ruckersteuer-    zeichen ";
  182. 910 print"kann man 640 [199]rafikspalten in"
  183. 915 print"doppelter [196]ichte drucken  ";a(2,3)
  184. 920 input"[145]";a(2,3):x=3:gosub1310:ifa$<>"j"goto905
  185. 925 gosub1300:print"[205]it wieviel [211]teuercodes bewerkstel-"
  186. 930 print"ligt man einen [193]usdruck von 320"
  187. 935 print"[211]palten in einfacher [196]ichte  ";a(2,4)
  188. 940 input"[145]";a(2,4):x=4:gosub1310
  189. 945 ifa$<>"j"goto925
  190. 950 gosub1300:print"[202]etzt ist es ausserdem noch wichtig,"
  191. 955 print"wieviel [211]teuerzeichen [201]hr [196]rucker zum"
  192. 960 print"[193]usdruck von 640 [211]palten in einfacher"
  193. 965 print"[199]roesse benoetigt  ";a(2,5)
  194. 970 input"[145]";a(2,5):x=5:gosub1310:ifa$<>"j"goto950
  195. 975 open1,8,15,"s:cad.printer.datas"
  196. 980 open2,8,2,"cad.printer.datas,s,w":print#2,d$
  197. 985 forx=0to5:fori=0toa(2,x)+2:print#2,a(i,x):nexti:nextx:close2
  198. 990 gosub305:close1:goto105
  199. 995 :
  200. 1000 :
  201. 1005 rem ********************************
  202. 1010 rem *   ausdruck einfache dichte   *
  203. 1015 rem ********************************
  204. 1020 :
  205. 1025 gosub1205:x=1:gosub1250:open4,4,a(1,5)
  206. 1030 x=5:fors=0to24:gosub1250:sys50475,320*s,0,0,1:print#4:nexts
  207. 1035 gosub1215:return
  208. 1040 :
  209. 1045 :
  210. 1050 rem ********************************
  211. 1055 rem *   ausdruck doppelte dichte   *
  212. 1060 rem ********************************
  213. 1065 :
  214. 1070 gosub1205:open4,4,a(1,3)
  215. 1075 fors=0to24step2:ze=15:ifs=24thenze=7
  216. 1080 x=0:sz=1:gosub1250:x=3:gosub1250:sys50475,s*320,1,0,1
  217. 1085 print#4:x=0:sz=ze:gosub1250:x=3:gosub1250:sys50475,320*s,1,1,1
  218. 1090 print#4:nexts:gosub1215:return
  219. 1095 :
  220. 1100 :
  221. 1105 rem ********************************
  222. 1110 rem *    druckerparameter pruefen  *
  223. 1115 rem ********************************
  224. 1120 :
  225. 1125 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  226. 1130 print"         [196]ruckerparameter pruefen      [146]":as=1:gosub1545:print
  227. 1135 ifddthenprint"[218]eilenabstand n/144 [201]nch :":print:x=0:gosub1340
  228. 1140 print"[218]eilenabstand 8/72 [201]nch :":print:x=1:gosub1340
  229. 1145 ifddthenprint"[196]oppelte [196]ichte /320 [208]unkte :":print:x=2:gosub1340
  230. 1150 ifddthenprint"[196]oppelte [196]ichte /640 [208]unkte :":print:x=3:gosub1340
  231. 1155 print"[197]infache [196]ichte /320 [208]unkte :":print:x=4:gosub1340
  232. 1160 print"[197]infache [196]ichte /640 [208]unkte :":print:x=5:gosub1340
  233. 1165 geta$:ifa$=""goto1165
  234. 1170 goto105
  235. 1175 :
  236. 1180 :
  237. 1185 rem ********************************
  238. 1190 rem *     kanaele oeffnen & schl.  *
  239. 1195 rem ********************************
  240. 1200 :
  241. 1205 open1,4,a(1,0):open2,4,a(1,1):open3,4,a(1,2):open7,4,a(1,3)
  242. 1210 open5,4,a(1,4):open6,4,a(1,5):return
  243. 1215 fori=1to9:closei:next:return
  244. 1220 :
  245. 1225 :
  246. 1230 rem ********************************
  247. 1235 rem *     druckersequenz senden    *
  248. 1240 rem ********************************
  249. 1245 :
  250. 1250 a=a(1,x)+1:ifa=4thena=7
  251. 1255 fori=3toa(2,x)+2:fk=1:ifx=0andi=a(2,0)+2thenfk=sz
  252. 1260 print#a,chr$(a(i,x)*fk);:next
  253. 1265 return
  254. 1270 :
  255. 1275 :
  256. 1280 rem ********************************
  257. 1285 rem *   eingabe der steuerzeichen  *
  258. 1290 rem ********************************
  259. 1295 :
  260. 1300 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  261. 1305 print"              [196]ruckeranpassung         [146]":gosub1545:return
  262. 1310 ifa(2,x)=0thenreturn
  263. 1315 print"":fori=3toa(2,x)+2:a$=right$(str$(i-2),2)
  264. 1320 print"[145][211]teuercode #";a$;"              [157][157][157][157][157][157][157][157][157][157]";a(i,x)
  265. 1325 input"[145]";a(i,x):nexti
  266. 1330 print"[211]ekundaeradresse  ";a(1,x):as=0
  267. 1335 input"[145]";a(1,x):as=0
  268. 1340 a$="  [211]ekundaeradresse "
  269. 1345 a$=a$+right$(str$(a(1,x)),len(str$(a(1,x)))-1)+": ":ifa(2,x)=0goto1365
  270. 1350 fori=3toa(2,x)+2:a$=a$+right$(str$(a(i,x)),len(str$(a(i,x)))-1)
  271. 1355 ifi<>a(2,x)+2thena$=a$+"/ "
  272. 1360 nexti:ifx=0thena$=a$+"*n"
  273. 1365 print"[145]";a$:ifasthenreturn
  274. 1370 print"[201]st dies korrekt ?"
  275. 1375 geta$:if(a$<>"n"anda$<>"j")goto1375
  276. 1380 return
  277. 1385 :
  278. 1390 :
  279. 1395 rem ********************************
  280. 1400 rem *     druckerkommando senden   *
  281. 1405 rem ********************************
  282. 1410 :
  283. 1415 print"[147] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  284. 1420 print"          [196]ruckerkommando senden       [146]":gosub1545
  285. 1425 input"[193]nzahl der [195]odes ";x$:x=val(x$):ifx$="_"orx$=""goto105
  286. 1430 print"":fori=1tox:a$=right$(str$(i),2)
  287. 1435 print"[145][211]teuercode #";a$;"               "
  288. 1440 input"[145]";b(i):nexti
  289. 1445 input"[211]ekundaeradresse ";sa
  290. 1450 a$="  [211]ekundaeradresse "
  291. 1455 a$=a$+right$(str$(sa),len(str$(sa))-1)+": "
  292. 1460 fori=1tox:a$=a$+right$(str$(b(i)),len(str$(b(i)))-1)
  293. 1465 ifi<>xthena$=a$+"/ "
  294. 1470 nexti:print"[145]";a$
  295. 1475 print"[201]st dies korrekt ?"
  296. 1480 geta$:ifa$<>"j"anda$<>"n"goto1480
  297. 1485 ifa$="n"goto1415
  298. 1490 open4,4,sa:fori=1tox:print#4,chr$(b(i));:next:close4:goto105
  299. 1495 :
  300. 1500 :
  301. 1505 rem ********************************
  302. 1510 rem *         kopf beim laden      *
  303. 1515 rem ********************************
  304. 1520 :
  305. 1525 poke53280,15:poke53281,15:poke646,11:printchr$(14)chr$(8)
  306. 1530 print"[147]     [183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]"
  307. 1535 print"     [199]iga-[195][193][196] [200]ardcopy loading..."
  308. 1540 print"     [175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175]":return
  309. 1545 print" [183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]"
  310. 1550 return
  311.